home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / guile / 1.8 / srfi / srfi-60.scm < prev    next >
Encoding:
Text File  |  2008-12-17  |  2.1 KB  |  73 lines
  1. ;;; srfi-60.scm --- Integers as Bits
  2.  
  3. ;; Copyright (C) 2005, 2006 Free Software Foundation, Inc.
  4. ;;
  5. ;; This library is free software; you can redistribute it and/or
  6. ;; modify it under the terms of the GNU Lesser General Public
  7. ;; License as published by the Free Software Foundation; either
  8. ;; version 2.1 of the License, or (at your option) any later version.
  9. ;; 
  10. ;; This library is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13. ;; Lesser General Public License for more details.
  14. ;; 
  15. ;; You should have received a copy of the GNU Lesser General Public
  16. ;; License along with this library; if not, write to the Free Software
  17. ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18.  
  19. (define-module (srfi srfi-60)
  20.   #:export (bitwise-and
  21.         bitwise-ior
  22.         bitwise-xor
  23.         bitwise-not
  24.         any-bits-set?
  25.         bit-count
  26.         bitwise-if bitwise-merge
  27.         log2-binary-factors first-set-bit
  28.         bit-set?
  29.         copy-bit
  30.         bit-field
  31.         copy-bit-field
  32.         arithmetic-shift
  33.         rotate-bit-field
  34.         reverse-bit-field
  35.         integer->list
  36.         list->integer
  37.         booleans->integer)
  38.   #:re-export (logand
  39.            logior
  40.            logxor
  41.            integer-length
  42.            logtest
  43.            logcount
  44.            logbit?
  45.            ash))
  46.  
  47. (load-extension "libguile-srfi-srfi-60-v-2" "scm_init_srfi_60")
  48.  
  49. (define bitwise-and logand)
  50. (define bitwise-ior logior)
  51. (define bitwise-xor logxor)
  52. (define bitwise-not lognot)
  53. (define any-bits-set? logtest)
  54. (define bit-count logcount)
  55.  
  56. (define (bitwise-if mask n0 n1)
  57.   (logior (logand mask n0)
  58.           (logand (lognot mask) n1)))
  59. (define bitwise-merge bitwise-if)
  60.  
  61. (define first-set-bit log2-binary-factors)
  62. (define bit-set? logbit?)
  63. (define bit-field bit-extract)
  64.  
  65. (define (copy-bit-field n newbits start end)
  66.   (logxor n (ash (logxor (bit-extract n start end)              ;; cancel old
  67.              (bit-extract newbits 0 (- end start))) ;; insert new
  68.          start)))
  69.  
  70. (define arithmetic-shift ash)
  71.  
  72. (cond-expand-provide (current-module) '(srfi-60))
  73.